#!/usr/bin/perl

package Swignition::Export::CalComponent;
use Swignition::Export;
use Swignition::Export::Alarm;
use Swignition::Export::BlogEntry;
use Swignition::Export::Event;
use Swignition::Export::FBInfo;
use Swignition::Export::Todo;
use Swignition::MagicString;
use HTML::Entities qw(encode_entities_numeric);

sub cc
{
	$_ = shift;
	s/\-([a-z])/uc($1)/eg;
	return $_;
}

sub is
{
	my $s = shift;

	return Swignition::Export::Alarm::is($s)
		||Swignition::Export::FBInfo::is($s)
		||Swignition::Export::BlogEntry::is($s)
		||Swignition::Export::Todo::is($s)
		||Swignition::Export::Event::is($s);
}

sub outputs
{
	return [
		{
			code  => 'ICS',
			name  => 'iCalendar',
			type  => 'text/directory',
			multi => 1
		}
	];
}

sub outICS
{
	return "BEGIN:VCALENDAR\r\n"
		. _outICS(@_)
		. "END:VCALENDAR\r\n";
}

sub multiICS
{
	my $triples = shift;
	my $rv = '';
	foreach my $s (keys %$triples)
	{
		$rv .= _outICS($triples, $s)
			if (defined $triples->{$s} && is($triples->{$s}));
	}

	return "BEGIN:VCALENDAR\r\n"
		. $rv
		. "END:VCALENDAR\r\n";
}

sub _outICS
{
	my $triples = shift;
	my $sURL    = shift;
	my $sObj    = $triples->{$sURL};

	if (Swignition::Export::Event::is($sObj))
		{ return Swignition::Export::Event::_outICS($triples, $sURL); }

	if (Swignition::Export::BlogEntry::is($sObj))
		{ return Swignition::Export::BlogEntry::_outICS($triples, $sURL); }

	if (Swignition::Export::Todo::is($sObj))
		{ return Swignition::Export::Todo::_outICS($triples, $sURL); }

	if (Swignition::Export::Alarm::is($sObj))
		{ return Swignition::Export::Alarm::_outICS($triples, $sURL); }
		
	if (Swignition::Export::FBInfo::is($sObj))
		{ return Swignition::Export::FBInfo::_outICS($triples, $sURL); }
}

sub _people
{
	my $triples = shift;
	my $S       = shift;
	my $dothem  = shift;
	
	my @rv;

	# Attendee
	if ($dothem =~ /a/i)
	{
		my @attendees = allOfObj($S, 'urn:ietf:rfc:2445#attendee',
			'http://www.w3.org/2002/12/cal/ical#attendee');
		foreach my $attendee (@attendees)
		{
			my $attendeeSubject = findSubject($triples, $attendee->toString);
			if ($attendeeSubject)
			{
				if (Swignition::Export::Contact::is($attendeeSubject))
				{
					
					# Taxonomy
					my @species = allOfObj($attendeeSubject,
						'http://purl.org/NET/biol/ns#hasTaxonomy');
					foreach my $species (@species)
					{
						my $speciesSubject = findSubject($triples, $species->toString);
						if ($speciesSubject)
						{
							if (Swignition::Export::Taxonomy::is($speciesSubject))
							{
								my $val = Swignition::Export::Taxonomy::outText($triples, $speciesSubject->uri);
								push @rv, ['X-SIGHTING-OF', $val];
							}
						}
						elsif (!$species->type)
						{
							push @rv, ['X-SIGHTING-OF', $species->toString, 1];
						}
					}
				
					my $astr = 'ATTENDEE';
	
					my $cn = firstOfLiteral($attendeeSubject,
						['http://buzzword.org.uk/rdf/icalx#cn',
						'http://www.w3.org/2006/vcard/ns#fn',
						'http://www.w3.org/2001/vcard-rdf/3.0#FN',
						'http://xmlns.com/foaf/0.1/fullName',
						'http://xmlns.com/foaf/0.1/name',
						'http://www.w3.org/2000/10/swap/pim/contact#knownAs',
						'http://purl.org/dc/terms/title',
						'http://purl.org/dc/elements/1.1/title'],
						['http://www.w3.org/1999/02/22-rdf-syntax-ns#value']);
					$astr .= ';CN='.$cn
						if (length $cn);
	
					my $cu = uc(firstOfLiteral($attendeeSubject,
						['http://buzzword.org.uk/rdf/icalx#cutype',
						'urn:ietf:rfc:2445#cutype',
						'http://buzzword.org.uk/rdf/vcardx#kind',
						'urn:ietf:rfc:2426#kind'],
						['http://www.w3.org/1999/02/22-rdf-syntax-ns#value']));
					$cu =~ s/^ORG$/GROUP/;
					$astr .= ';CUTYPE='.$cu
						if (length $cu);
						
					foreach my $prop (qw(rsvp partstat))
					{
						my $val = firstOfLiteral($attendeeSubject,
							['urn:ietf:rfc:2445#'.$prop,
							'http://buzzword.org.uk/rdf/icalx#'.$prop],
							['http://www.w3.org/1999/02/22-rdf-syntax-ns#value']);
						$astr .= ';'.uc($prop).'='.uc($val) if (length $val);
					}
					foreach my $prop (qw(member delegated-from delegated-to))
					{
						my $val = firstOfLiteral($attendeeSubject,
							['urn:ietf:rfc:2445#'.$prop,
							'http://buzzword.org.uk/rdf/icalx#'.cc($prop)],
							['urn:ietf:rfc:2445#value',
							'urn:ietf:rfc:2426#value',
							'http://www.w3.org/1999/02/22-rdf-syntax-ns#value']);
						$val =~ s/\?.*$//;
						$val =~ s/^mailto/MAILTO/;
						$astr .= ';'.uc($prop).'="'.$val.'"' if (length $val);
					}
					
					my $agent = firstOf($attendeeSubject,
						'http://www.w3.org/2006/vcard/ns#agent',
						'urn:ietf:rfc:2426#agent');
					my $agentSubject = findSubject($triples, $agent);
					if ($agentSubject)
					{
						my $val = firstOfLiteral($agentSubject,
							['urn:ietf:rfc:2426#email',
							'http://www.w3.org/2006/vcard/ns#email',
							'http://www.w3.org/2006/vcard/ns#workEmail',
							'http://www.w3.org/2006/vcard/ns#mobileEmail',
							'http://www.w3.org/2006/vcard/ns#unlabelledEmail',
							'http://www.w3.org/2001/vcard-rdf/3.0#EMAIL',
							'http://www.w3.org/2000/10/swap/pim/contact#emailAddress',
							'http://xmlns.com/foaf/0.1/mbox',
							'http://xmlns.com/foaf/0.1/mbox_sha1sum'],
							['urn:ietf:rfc:2426#value',
							'http://www.w3.org/1999/02/22-rdf-syntax-ns#value']);
						$val =~ s/\?.*$//;
						$val =~ s/^mailto/MAILTO/;
						$astr .= ';DELEGATE-TO="'.$val.'"' if (length $val);
					}
	
					my @roles = allOfLiteral($attendeeSubject,
						['urn:ietf:rfc:2426#role',
						'http://www.w3.org/2006/vcard/ns#role',
						'http://www.w3.org/2001/vcard-rdf/3.0#ROLE'],
						['urn:ietf:rfc:2426#value',
						'http://www.w3.org/1999/02/22-rdf-syntax-ns#value']);
					foreach my $r (@roles)
					{
						if ($r =~ /^((REQ|OPT|NON)\-PARTICIPANT|CHAIR|X\-.+)$/i)
							{ 	$astr .= ';ROLE='.uc($r); }
						else
							{ $r =~ s/[^A-Z0-9-]//gi; $astr .= ';ROLE=X-'.uc($r); }
					}
	
					my $email = firstOfLiteral($attendeeSubject,
						['urn:ietf:rfc:2426#email',
						'http://www.w3.org/2006/vcard/ns#email',
						'http://www.w3.org/2006/vcard/ns#workEmail',
						'http://www.w3.org/2006/vcard/ns#mobileEmail',
						'http://www.w3.org/2006/vcard/ns#unlabelledEmail',
						'http://www.w3.org/2001/vcard-rdf/3.0#EMAIL',
						'http://www.w3.org/2000/10/swap/pim/contact#emailAddress',
						'http://xmlns.com/foaf/0.1/mbox',
						'http://xmlns.com/foaf/0.1/mbox_sha1sum'],
						['urn:ietf:rfc:2426#value',
						'http://www.w3.org/1999/02/22-rdf-syntax-ns#value']);
					$email =~ s/\?.*$//;
					$email =~ s/^mailto/MAILTO/;
	
					$astr .= _vcardurl($triples, $attendeeSubject->uri);

					if (length $email)
						{ push @rv, [$astr, $email]; }
					else
						{ push @rv, [$astr.';VALUE=TEXT', $cn]; }
						
				}
				else
				{
					my $a = firstOfLiteral($attendeeSubject,
						['urn:ietf:rfc:2426#fn',
						'http://www.w3.org/2006/vcard/ns#fn',
						'http://www.w3.org/2001/vcard-rdf/3.0#FN',
						'http://xmlns.com/foaf/0.1/fullName',
						'http://xmlns.com/foaf/0.1/name',
						'http://www.w3.org/2000/10/swap/pim/contact#knownAs',
						'http://purl.org/dc/terms/title',
						'http://purl.org/dc/elements/1.1/title'],
						['urn:ietf:rfc:2426#value',
						'http://www.w3.org/1999/02/22-rdf-syntax-ns#value']);
					push @rv, ['ATTENDEE;VALUE=TEXT',$a] if ($a);
				}
			}
			elsif ($attendee->type)
			{
				push @rv, ['ATTENDEE;VALUE=uri',$attendee->toString];
			}
			else
			{
				my $a = $attendee->toString;
				$a =~ s/(^\s+|\s+$)//g;
				$a =~ s/\s+/ /g;
				push @rv, ['ATTENDEE;VALUE=TEXT',$a] if ($a);
			}
		}
	}
		
	# contacts
	if ($dothem =~ /c/i)
	{
		my @contacts = allOfObj($S, 'urn:ietf:rfc:2445#contact',
			'http://www.w3.org/2002/12/cal/ical#contact');
		foreach my $contact (@contacts)
		{
			my $contactSubject = findSubject($triples, $contact->toString);
			if ($contactSubject)
			{
				if (Swignition::Export::Contact::is($contactSubject))
				{
					my $fn = firstOfLiteral($contactSubject,
						['http://buzzword.org.uk/rdf/icalx#cn',
						'urn:ietf:rfc:2426#cn',
						'urn:ietf:rfc:2426#fn',
						'http://www.w3.org/2006/vcard/ns#fn',
						'http://www.w3.org/2001/vcard-rdf/3.0#FN',
						'http://xmlns.com/foaf/0.1/fullName',
						'http://xmlns.com/foaf/0.1/name',
						'http://www.w3.org/2000/10/swap/pim/contact#knownAs',
						'http://purl.org/dc/terms/title',
						'http://purl.org/dc/elements/1.1/title'],
						['urn:ietf:rfc:2445#value',
						'urn:ietf:rfc:2426#value',
						'http://www.w3.org/1999/02/22-rdf-syntax-ns#value']);
					my $adr = firstOfLiteral($contactSubject,
						['urn:ietf:rfc:2426#adr',
						'http://www.w3.org/2006/vcard/ns#adr',
						'http://www.w3.org/2006/vcard/ns#homeAdr',
						'http://www.w3.org/2006/vcard/ns#workAdr',
						'http://www.w3.org/2006/vcard/ns#unlabelledAdr',
						'http://www.w3.org/2001/vcard-rdf/3.0#ADR',
						'http://www.w3.org/2000/10/swap/pim/contact#address'],
						['urn:ietf:rfc:2426#value',
						'http://www.w3.org/1999/02/22-rdf-syntax-ns#value']);
					my $Adr = findSubject($triples, $adr);
					if ($Adr && Swignition::Export::Location::is($Adr))
					{
						my $adrline = "$fn, " .
							Swignition::Export::Location::outText($triples, $Adr->uri);
						$adrline =~ s/\, $//;
						my $astr = 'CONTACT'._vcardurl($triples, $contactSubject->uri);
						push @rv, [$astr, $adrline] if ($adrline);
					}
					else
					{
						my $astr = 'CONTACT'._vcardurl($triples, $contactSubject->uri);
						push @rv, [$astr, $fn];
					}
					
				}
				else
				{
					my $a = firstOfLiteral($contactSubject,
						['http://buzzword.org.uk/rdf/icalx#cn',
						'urn:ietf:rfc:2426#fn',
						'urn:ietf:rfc:2445#cn',
						'http://www.w3.org/2006/vcard/ns#fn',
						'http://www.w3.org/2001/vcard-rdf/3.0#FN',
						'http://xmlns.com/foaf/0.1/fullName',
						'http://xmlns.com/foaf/0.1/name',
						'http://www.w3.org/2000/10/swap/pim/contact#knownAs',
						'http://purl.org/dc/terms/title',
						'http://purl.org/dc/elements/1.1/title'],
						['urn:ietf:rfc:2426#value',
						'urn:ietf:rfc:2445#value',
						'http://www.w3.org/1999/02/22-rdf-syntax-ns#value']);
					push @rv, ['CONTACT',$a] if ($a);
				}
			}
			elsif ($contact->type)
			{
				push @rv, ['CONTACT;VALUE=uri',$contact->toString];
			}
			else
			{
				my $a = $contact->toString;
				$a =~ s/(^\s+|\s+$)//g;
				$a =~ s/\s+/ /g;
				push @rv, ['CONTACT',$a] if ($a);
			}
		}
	}
	
	if ($dothem =~ /o/i)
	{
		my @organizers = allOfObj($S, 'urn:ietf:rfc:2445#organizer',
			'http://www.w3.org/2002/12/cal/ical#organizer');
		foreach my $organizer (@organizers)
		{
			my $organizerSubject = findSubject($triples, $organizer->toString);
			if ($organizerSubject)
			{
				if (Swignition::Export::Contact::is($organizerSubject))
				{
					my $astr = 'ORGANIZER';
	
					my $cn = firstOfLiteral($organizerSubject,
						['http://buzzword.org.uk/rdf/icalx#cn',
						'urn:ietf:rfc:2445#cn',
						'urn:ietf:rfc:2426#fn',
						'http://www.w3.org/2006/vcard/ns#fn',
						'http://www.w3.org/2001/vcard-rdf/3.0#FN',
						'http://xmlns.com/foaf/0.1/fullName',
						'http://xmlns.com/foaf/0.1/name',
						'http://www.w3.org/2000/10/swap/pim/contact#knownAs',
						'http://purl.org/dc/terms/title',
						'http://purl.org/dc/elements/1.1/title'],
						['urn:ietf:rfc:2426#value',
						'urn:ietf:rfc:2445#value',
						'http://www.w3.org/1999/02/22-rdf-syntax-ns#value']);
					$astr .= ';CN='.$cn
						if (length $cn);
	
					foreach my $prop (qw(sent-by))
					{
						my $val = firstOfLiteral($organizerSubject,
							['http://buzzword.org.uk/rdf/icalx#'.cc($prop),
							'urn:ietf:rfc:2445#'.$prop],
							['urn:ietf:rfc:2445#value',
							'http://www.w3.org/1999/02/22-rdf-syntax-ns#value']);
						$val =~ s/\?.*$//;
						$val =~ s/^mailto/MAILTO/;
						$astr .= ';'.uc($prop).'="'.$val.'"' if (length $val);
					}
					
					my $agent = firstOf($organizerSubject,
						'http://www.w3.org/2006/vcard/ns#agent',
						'urn:ietf:rfc:2426#agent');
					my $agentSubject = findSubject($triples, $agent);
					if ($agentSubject)
					{
						my $val = firstOf($agentSubject,
							'urn:ietf:rfc:2426#email',
							'http://www.w3.org/2006/vcard/ns#email',
							'http://www.w3.org/2006/vcard/ns#workEmail',
							'http://www.w3.org/2006/vcard/ns#mobileEmail',
							'http://www.w3.org/2006/vcard/ns#unlabelledEmail',
							'http://www.w3.org/2001/vcard-rdf/3.0#EMAIL',
							'http://www.w3.org/2000/10/swap/pim/contact#emailAddress',
							'http://xmlns.com/foaf/0.1/mbox',
							'http://xmlns.com/foaf/0.1/mbox_sha1sum');
						$val =~ s/\?.*$//;
						$val =~ s/^mailto/MAILTO/;
						$astr .= ';SENT-BY="'.$val.'"' if (length $val);
					}
	
					my $email = firstOf($organizerSubject,
						'urn:ietf:rfc:2426#email',
						'http://www.w3.org/2006/vcard/ns#email',
						'http://www.w3.org/2006/vcard/ns#workEmail',
						'http://www.w3.org/2006/vcard/ns#mobileEmail',
						'http://www.w3.org/2006/vcard/ns#unlabelledEmail',
						'http://www.w3.org/2001/vcard-rdf/3.0#EMAIL',
						'http://www.w3.org/2000/10/swap/pim/contact#emailAddress',
						'http://xmlns.com/foaf/0.1/mbox',
						'http://xmlns.com/foaf/0.1/mbox_sha1sum');
					$email =~ s/\?.*$//;
					$email =~ s/^mailto\:/MAILTO\:/;
					
					unless ($email =~ /^MAILTO\:/)
					{
						my $E = findSubject($triples, $email);
						if ($E)
						{
							$email = firstOf($E,
								'urn:ietf:rfc:2426#value',
								"http://www.w3.org/1999/02/22-rdf-syntax-ns#value");
							
							$email = "MAILTO:$email"
								unless ($email =~ /^MAILTO\:/i);
						}
					}

					$astr .= _vcardurl($triples, $organizerSubject->uri);

					if (length $email)
						{ push @rv, [$astr, $email]; }
					else
						{ push @rv, [$astr.';VALUE=TEXT', $cn]; }
						
				}
				else
				{
					my $a = firstOfLiteral($organizerSubject,
						['http://buzzword.org.uk/rdf/icalx#cn',
						'urn:ietf:rfc:2426#fn',
						'http://www.w3.org/2006/vcard/ns#fn',
						'http://www.w3.org/2001/vcard-rdf/3.0#FN',
						'http://xmlns.com/foaf/0.1/fullName',
						'http://xmlns.com/foaf/0.1/name',
						'http://www.w3.org/2000/10/swap/pim/contact#knownAs',
						'http://purl.org/dc/terms/title',
						'http://purl.org/dc/elements/1.1/title'],
						['urn:ietf:rfc:2426#value',
						'http://www.w3.org/1999/02/22-rdf-syntax-ns#value']);
					push @rv, ['ORGANIZER;VALUE=TEXT',$a] if ($a);
				}
			}
			elsif ($organizer->type)
			{
				push @rv, ['ORGANIZER;VALUE=uri',$organizer->toString];
			}
			else
			{
				my $a = $organizer->toString;
				$a =~ s/(^\s+|\s+$)//g;
				$a =~ s/\s+/ /g;
				push @rv, ['ORGANIZER;VALUE=TEXT',$a] if ($a);
			}
		}
	}
	
	return @rv;
}

sub _vcardurl
{
	my $triples = shift;
	my $person  = shift;
	
	my $vcard = Swignition::Export::Contact::outVCF($triples, $person);
	if (length $vcard)
	{
		my $u = URI->new("data:");
		$u->media_type("text/directory");
		$u->data($vcard);
		return ";VCARDURL=\"$u\"";
	}
	
	return '';
}

# iCalendar insists on a particular profile of ISO dates, and insists that times
# must be in either the floating timezone or UTC.
sub _dt
{
	my $dt = shift;
	
	if ((ref $dt) =~ /^DateTime/)
	{
		$dt->set_time_zone('UTC');
		
		return $dt->strftime('%Y%m%d')
			if ($dt->{resolution} eq 'day');
			
		return $dt->strftime('%Y%m%dT%H%M%SZ');
	}
	
	return "$dt";
}

1;
